home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / vol7n12.arc / SEEKTEXT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-04-28  |  2.1 KB  |  67 lines
  1. PROGRAM SeekToTextDemo;  
  2.  
  3.   FUNCTION SeekToText(VAR TextFile : Text; OffSet : Real) : Integer;
  4.   TYPE {see the Turbo Pascal 3.X reference manual for the FIB layout}
  5.     FIBtype = RECORD
  6.       Handle, RecLength, BufOff, BufSize, BufPtr, BufEnd : Integer;
  7.       FilePath : ARRAY[1..64] OF Char;
  8.     END;            {FIBtype}
  9.   VAR
  10.     ByteFile : FILE OF Byte ABSOLUTE TextFile;
  11.     FIB      : FIBtype ABSOLUTE TextFile;
  12.     SaveRL   : Integer;
  13.   BEGIN                       {SeekToText}
  14.     WITH FIB DO
  15.       BEGIN
  16.         SaveRL := RecLength;    {RecLength actually holds flags and}
  17.                                 {maybe a char from the text file}
  18.         RecLength := 1;         {A byte file "record" is one byte}
  19.         {$I-} LongSeek(ByteFile, OffSet); {$I+}
  20.         SeekToText := IOResult; {The caller must deal with IO errors}
  21.         RecLength := SaveRL;    {restore values for the text file}
  22.         BufPtr := BufEnd;       {force next Read/ReadLn to refill buffer}
  23.       END;
  24.   END;                        {PROCEDURE SeekToText}
  25.  
  26. VAR
  27.   DemoFile : Text;
  28.   i, j     : Integer;
  29.   MaxLine  : STRING[255];
  30. CONST
  31.   DFOffsets : ARRAY[1..4] OF Real = (95, 0, 143, 43);
  32.   DFName = 'DEMOFILE.TXT';
  33.  
  34. BEGIN                         {SeekToTextDemo}
  35.   Assign(DemoFile, DFName);
  36.   {$I-} Reset(DemoFile);      {$I-}
  37.   IF IOResult <> 0 THEN
  38.     BEGIN
  39.       WriteLn('Failed to open ', DFName);
  40.       Halt(IOResult);
  41.     END;                        {if IOResult <> 0}
  42.   FOR i := 1 TO 4 DO
  43.     BEGIN
  44.       j := SeekToText(DemoFile, DFOffsets[i]);
  45.       IF j <> 0 THEN
  46.         BEGIN
  47.           WriteLn('SeekToText failure with DFOffsets[', i, ']');
  48.           Halt(j);
  49.         END {j <> 0}
  50.       ELSE
  51.         BEGIN   {j = 0}
  52.           ReadLn(DemoFile, MaxLine);
  53.           WriteLn(MaxLine);
  54.         END;                      {j = 0}
  55.     END;                        {for i := 1 to 4}
  56.   WriteLn;
  57.   {$I-} Close(DemoFile);      {$I-}
  58.   IF IOResult <> 0 THEN
  59.     BEGIN
  60.       WriteLn('Failed to close ', DFName);
  61.       Halt(IOResult);
  62.     END;                        {if IOResult <> 0}
  63.   WriteLn('All operations concluded successfully.')
  64. END.
  65.  
  66.  
  67.